(define-syntax letcc
  (syntax-rules ()
                ((letcc hop body ...)
                 (call/cc (lambda (hop)  body ...)))))
;; Use var continuation if failed
(define-syntax try
  (syntax-rules ()
    ((try var a . b)
     (letcc success (letcc var (success a)) . b))))

(define (atom? x)
  (not (or (pair? x) (null? x))))

(define (member? a lat)
  (cond
    ((null? lat) #f)
    ((eq? a (car lat)) #t)
    (else (member? a (cdr lat)))))

(define (pick n lat)
  (list-ref lat (- n 1)))

(define Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f)
       (le (lambda (x) ((f f) x)))))))

(define (multirember a lat)
  ((Y (lambda (mr)
        (lambda (lat)
          (cond ((null? lat) '())
                ((eq? a (car lat)) (mr (cdr lat)))
                (else (cons (car lat) (mr (cdr lat))))))))
   lat))

(define eqlist? equal?)
(define (add1 n) (+ n 1))
(define (sub1 n) (- n 1))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 检查是否有相邻的两个 atom 相同。
;; (define (two-in-a-row? lat)
;;   (define (is-first? a lat)
;;     (if (null? lat)
;;       #f
;;       (eq? (car lat) a)))
;;   (cond
;;     ((null? lat) #f)
;;     ((is-first? (car lat) (cdr lat)) #t)
;;     (else (two-in-a-row? (cdr lat)))))

;;(define (two-in-a-row? lat)
;;  (define (is-first-b? a lat)
;;    (cond ((null? lat) #f)
;;          ((eq? (car lat) a) #t)
;;          (else (two-in-a-row? lat))))
;;  (if (null? lat)
;;    #f
;;    (is-first-b? (car lat) (cdr lat))))


(define (two-in-a-row? lat)
  (define (two-in-a-row-b? a lat)
    (cond ((null? lat) #f)
          ((eq? (car lat) a) #t)
          (else (two-in-a-row-b? (car lat) (cdr lat)))))
  (if (null? lat)
    #f
    (two-in-a-row-b? (car lat) (cdr lat))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; 感觉我这个版本还简单一些？
;; (define (sum-of-prefixes tup)
;;   (if (null? tup)
;;     '()
;;     (cons (car tup)
;;           (map (lambda (x) (+ (car tup) x))
;;                (sum-of-prefixes (cdr tup))))))

(define (sum-of-prefixes tup)
  (define (sum-of-prefixes-b sonssf tup)
    (cond ((null? tup) '())
          (else (cons (+ sonssf (car tup))
                      (sum-of-prefixes-b (+ sonssf (car tup))
                                         (cdr tup))))))
  (sum-of-prefixes-b 0 tup))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; My implementation
(define (scramble tup)
  (define (scramble-helper rest head-index)
    (if (null? rest)
      '()
      (cons (pick (+ 1 (- head-index (car rest))) tup)
            (scramble-helper (cdr rest) (+ 1 head-index)))))
  (scramble-helper tup 1))

;; Book implementation
(define (scramble tup)
  (define (scramble-b tup rev-pre)
    (if (null? tup)
      '()
      (let* ((head (car tup))
             (tail (cdr tup))
             (new-rev (cons head rev-pre)))
        (cons (pick head new-rev)
              (scramble-b tail new-rev)))))
  (scramble-b tup '()))
